# CCN::Text.pm
# Copyright (C) 2006  Stephane Alnet
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
# 

#
# For more information visit http://carrierclass.net/
#

package CCN::Text;
use strict; use warnings;
use Carp;
use Exporter::Lite;

our @EXPORT = qw( &copyright &content_of &output_of &print_to &template &template_text );

# Prepends a GPL copyright notice to generated files.
sub copyright($)
{
    my $t = <<'EOT';
# Copyright (C) 2006  Stephane Alnet
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
# 
EOT
    my $s = shift;
    return $t if not defined $s;
    $t =~ s/#/substr($s,0,1)/ge;
    return "$s\n$t\n";
}

sub content_of($)
{
    my ($src) = @_;
    open my $file, '<', $src
        or return undef;
    local $/; # Slurp mode
    my $text = <$file>;
    close $file;
    return $text;
}

sub output_of($)
{
    my ($cmd) = @_;
    open my $file, "$cmd |"
        or return undef;
    local $/; # Slurp mode
    my $text = <$file>;
    close $file;
    return $text;
}

sub print_to($$)
{
    my ($dst,$text) = @_;
    open my $file, '>', $dst
        or return "INTERNAL ERROR: open $dst: $!\n";
    print $file $text
        or return "INTERNAL ERROR: print $dst: $!\n";
    close $file;
    return '';
}



sub template($$$)
{
    my ($src,$dst,$context) = @_;

    my $text = content_of($src);
    
    return "INTERNAL ERROR: read $src: $!\n"
        if not defined $text
        or $text eq ''; # no empty templates, please
    
    return "INTERNAL ERROR: no context\n"
        if not defined $context;
    
    my %missing = ();
    $text =~ s/_{(\w+)}_/exists($context->{$1}) ? $context->{$1} : ($missing{$1} = 1, '')/ge;

    my @missing = sort keys %missing;
    return "INTERNAL ERROR: Missing parameters for $src: ".join(' ',@missing)."\n"
        if $#missing >= 0;

    return print_to($dst,$text);
}

sub template_text($$)
{
    my ($text,$context) = @_;
    
    croak "INTERNAL ERROR: Invalid template\n"
        if not defined $text
        or $text eq '';

    croak "INTERNAL ERROR: no context\n"
        if not defined $context;

    my %missing = ();
    $text =~ s/_{(\w+)}_/exists($context->{$1}) && defined($context->{$1}) ? $context->{$1} : ($missing{$1} = 1, '')/ge;

    my @missing = sort keys %missing;
    croak "INTERNAL ERROR: Missing template parameters: ".join(' ',@missing)."\n"
        if $#missing >= 0;

    return $text;
}


sub text_to_hex($)
{
    return join '', map { sprintf "%02X", $_ } unpack("U*",shift);
}

sub hex_to_text($)
{
    return pack('H*',shift);
}

sub mac_to_dotted($)
{
    my $t = lc(shift);
    $t =~ s/^(..)(..)(..)(..)(..)(..)$/$1:$2:$3:$4:$5:$6/;
    return $t;
}

sub mac_from_dotted($)
{
    my $t = lc(shift);
    $t =~ s/[^\da-f]//g;
    return $t;
}

sub qr_mac_clean($) { $a = mac_from_dotted(shift); return mac_to_dotted($a); }


1;